Appendix A 



#!/usr/bin/perl -w 

Shtmljitle = $0; 
$html_title =- s/.*V(\w+)$/$1/; 
$cgLname = $htmljitle; 
$html_tit!e si J /g; 

$[=1; 
$debug = 0; 

$answercookiename = "chaincookie"; 
$answercookiefilter = "[-0123456789:.]+"; 
$levelcookiename = "chainlevel"; 
@questions_2b_asked = (); 

($num_questions,$num_conditions,$max_ievel) = read__dat_file(); 

if ($debug) { addbody("# questions=$num_questions, # conditions=$num_conditions, max 
lvl=$max_level<br>\n"); } 

($first_unanswered_question,$level) = get_state_from_cookie($num_questions); 

if ($debug) {addbody("get_stateJrom_cookie:first=$first_unanswered_questionJevel=$level< 

update_state_from_form(); 

$new_answercookie = join(":", ©answers); 
$newJevelcookie = $Ievel+1 ; 
if ( $debug ) { 

addbody("new_level=$newJevelcookie\n<br>"); 

addbody("new answer cookie = $new_answercookie\n"); 

if ( $new_answercookie /$answercookiefilter/ ) { 
addbody("new_answercookie passed filter\n"); 

} 

} 

if ($debug) { addbody("\n\n\n"); } 

if ($level > $maxjevel) { 
while {(Sdiag, $factorJist) = each %condition) { 
if ( $debug ) { addbody("$diag (has factors $factorJlst)<br>\n"); } 
©factors = split(',', $factor_ljst); 

if ( $debug ) { addbody("$#factors items in \@factors<br>\n"); } 
$score = 0; $max = 0; $num_answers=0; 
foreach $factor (©factors) { 
($question,$weight) = $factor =- /q(\d+)=(\d+\.*\d*)/; 
$max = $max + $weight; 
if ( $answers[$question] > 0 ) { 
$score = $score + ( $weight * $answers[$question] ); 
$num_answers++; 

} 

$answer = $answers[$question]; 

if ( $debug ) { addbody(" pondering $question $weight. It was \"$answer\" so new score = 
$score<br>\n"); } 
$question++; 

} 
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if ( $num__answers==0 ) { $num_answers=1 ; } 

$score = int( $score / $num_answers * 100) / 100; 

if ( $debug ) { acldbocly( " final score = $score ($max max)\n"); } 

$a{$diag} = $score; 
$question++; 

} 

it ( $debug ) { print "\n"; } 

@unsorted = (); 

foreacii $diag (keys(%a)) { 

$url = $diag; 

$url sl[\f]IJg; 

$url =- s/n//g; 

$url = 'Mp://adsl-63-1 94-251 -2.dslJsan03.pacbell.net/igotpain/$cgi_name/$url.litml'^^ 
@unsorted = ( "$a{$diag}\t\t<a href=\"$url\" TARGET=\"referenceV'>$diag</a>\n", @unsorted ); 

} 

if ( $debug ) { addbody("</PRE>\n"); } 

addbody("<PRE>\n"); 

addbody( "% Possibility\tCondition\n"); 

addbody(reverse(sort sortdiags @unsorted)); 

addbody("</PRE>\n"); 

if ( $debug ) { addbody("</PRE>\n"); } 

addbody("(Back to <A HREF=\7igotpain/welcome.htnnl\" TARGET=\"reference\">vitruvian man</A>)"); 
if ( $debug ) { addbody("<PRE>\n"); } 
$new__answercookie = ""; 
Snewjevelcookie = ""; 

} 

else { # ask another set of questions 
if ($debug) { addbody("</PRE>\n"); } 

addbody("<FORM method=\"POST\" action=\7cgi-bln/igp/$cgi_nanne\">\n"); 
@questions_2b_asked = build_questionJist($level, $maxjevel, $first_unanswered_question, 
$num_questions); 
$new__answercookie = joinf:", ©answers); 
$newJevelcookie = $level+1 ; 
if ( $debug ) { 

addbody("newJevel=$new_levelcookie, oldJevel=$level\n<br>"); 
addbody("new answer cookie = $new_answercookie\n"); 
if ( $new_answercookle /($answercookiefilter)/ ) { 
addbody("new_answercookie passed filter\n"); 

} 

} 

$current_lieader = ""; 

foreach $qdata (@questions_2b_asked) { 

($qnum,$level,$depend,$help_ref,$question,$qheader) = split("xyzzy",$qdata); 

if ( $current_iieader ne Sqtieader ) { 
$current_header = $qheader; 

addbody("<TABLE BGCOLOR=\"#A0A0A0\"><TR><TD ALIGN=\"LEFT\" 
COLSPAN=2><H2>$current_header</H2></TD></TR>\n"); 

} 

addbody("<TR>\n"); 

addbody(get_question_htnnl("q$qnunn",$question,$lie!p__ref,"no")); 
addbody("</TR>\n"); 

} 

addbody("</TABLE>\n"); 

addbody("<input type=\"submit\" value=V'Proceed\">\n"); 
addbody("<input type=\"resetV>\n"); 
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addbody("</FORM>\n"); 

if ($debug) { addbody("<PRE>\n"); } 

} 

sub sortdiags { 
($aa) = split("\f,$a); 
($bb) = split("\t",$b); 
#$aa = sprintf("%3.4d",$aa); 
#$bb = sprintf("%3.4d",$bb); 
($aa<=>$bb) 

} 

II II II 

m# do the printout 

II II tt H H It II tl II II n tt 

till II II 11 11 It II II II II II 
II It tl 11 ll II II II li H II It 

&printheader{$new_answercookie,$new_levelcookie); 

printhtmlO; 

exit 0; 

#xxxxxxxxx 

sub build_questionJist { 

local ($lastjev, $maxjev, $first_q, $last_q) = @_; 

local ($qlevel,$qdepend,$clep_qnum,$dep_answer); 

@qlist = 0; 

If ($debug) { addbody("in build_questionJist(last=$lastJev, max=$maxjev, first=$first_q, 
last=$last_q)\n<br>"); } 
foreach $qnum ( $first_q..$last_q ) { 
if ( $answers[$qnunn] != -1 ) { 
if ($debug) { addbody("q#$qnum skipped<br>\n");} 
next; 

} 

($iqnum,$qlevel,$qdepend) = split("xyzzy",$q[$qnum]); 

if ($debug) { addbody{"qnum = $iqnum($qnum); qlevel = $qlevel; qdepend = $qdepend<br>\n"); } 
($dep__qnum,$dep_answer) = $qdepend /(\d+)([+-]*)/; 
if ( $dep_answer A+/ ) { $dep_answer = "1"; } 
if ( $dep_answer /-/ ) { $dep_answer = "0"; } 

if ($debug) { addbody("answers[$dep_qnunn]=$answers[$dep_qnum], dep_qnum=$dep_qnum, 
dep_answer=$dep_answer<BR>\n"); } 
if ( $qlevel == $lastjev ) { 
if ( $dep_qnum == 0 || $answers[$dep_qnum] == $dep_answer ) { 
push(@qlist,$q[$qnum]); 
if ($debug) { addbody("pushed $q[$qnum]\n"); } 

} 

} 

} 

if ( $debug ) { 
addbody( "build_question Jist = \n"); 
foreach $line (@qlist) { addbody( "$!ine\n"); } 

} 

@qlist; 

} 
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sub update_state_from Jorm { 
$n = <>; 

$n = unless ($n); 

if ( $debug ) { addbody( "STDIN: $n\n<br>"); } 
@question_answer = split{/&/, $n); 
foreach ( @question_answer ) { 
if ( Sdebug ) { addbody("$_ : "); } 
if ( /q{\d+)=(\w+)/ ) { 

($qnum,$val) = ($1,$2); 

if ( Sdebug ) { addbody("$qnum => $val\n"); } 

if ($val eq "yes") { $answers[$qnunn] = 1 ; } 

if ($val eq "sometimes") { $answers[$qnum] = .75; } 

if ($val eq "maybe") { $answers[$qnum] = .45; } 

if ($val eq "unknown") { $answers[$qnum] = .2; } 

if ($val eq "no") { $answers[$qnum] = 0; } 

} 

if ( $n =~ /R=yes/ ) { $answers[$qnum] = -1 ; } 

} 

} 

sub read_dat_fi!e { 
local ($number_of_questions,$number_of_conditions,$max_lev) = (0,0,0); 
local ($line,$condition_name,$factors) = ("",""/'"); 

local ($qnum.$qievel,$depend,$help_ref,$question,$current_header) = (0,0,"","","",""); 

open(DAT, "<$cgi_name.dat") || die("test.dat unreadable\n"); 

@dat = <DAT>; 

close(DAT); 

foreach $line (@dat) { 
If ( $line r'(r']+)",nd+","\d+",.*)$/ ) { 
if ( Sdebug ) { addbody("\n<br>condition line: $line"); } 
($condition_name , $line) = ($1,$2); 
$number_of_conditions++; 
$line s/7/g; 
@factors = split(/,/,$line); 

foreach $n (l.$#factors) { $factors[$n] = "q$n=$factors[$n]"; } 
$factors = join{",",@factors); 
$condition{$condltion_name} = $factors; 

if ( Sdebug ) { addbody("\%condition $condition_name = Sfactors"); } 

} 

elsif ( Sline =- /'^{\d+) (\d+) (\d+[+-]*) {\w+) (.*)/ ) { 
if ( Sdebug ) { addbody("question line: Sline"); } 
{$qnum,$qlevel,$depend,$help_ref,Squestion) = ($1,S2,S3,S4,$5); 
$q[$qnum] =join("xyzzy",(Sqnum,Sqlevel,Sdepend,$help_ref,$question,Scurrent_header)); 
$number_of__questions++; 
if ( Sqlevel > Smaxjev ) { $max_lev = Sqlevel; } 

} 

elsif ( Sline /^H (.*)/ ) { $current_header = S1 ; } 
else { 

if { Sdebug ) { addbodyfunprocessed line:\n$line\n"); } 

} 

} 

If ( Sdebug ) { 
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adclbody("number_of_questions = $number_of_questions, nunnber_of_conditions = 
$number__of_conditions, maxjev = $max_Iev\n"); 

} 

($number_of_questions,$number_of_conditions,$maxjev); 

} 



### Cookies #### 

sub get_state_from_cookie { 
local (Sqnum) = @_; 
local ($first,$qlevei) = (1,1); 

$env_cookie = $ENV{HTTP_COOKIE}; 
if ( $debug) { 

addbody("env_cookie = $env_cookie \n"); 

add body ("coo kief liter = $answercookiefilter \n"); 

} 

if ( $env_cookie =- /$answercooklenanne=($answercookiefi!ter)/ ) { $cookie = $1; } 
if ( $env_cookie ~- /$levelcookiename=(\d+)/ ) { $qlevel = $1 ; } 
if ( $debug ) { add body ("filtered cookie = $cookie\n"); } 
if ( $cookie ) { 
©answers = split(/:/, $cookie); 

until ( ($answers[$first] == -1) || ($first > 80) ) { $flrst++; } 

} 

else { 

foreach $n (1 .. Sqnum) { $answers[$n] = -1; } 
$first = 1 ; 

if ( Sdebug ) { addbody("initialized Sqnum answers to -1\n"); } 

} 

(Sfirst,$qlevel); 



### HTML stuff ### 

sub get_question_html { 
local ($name,Squestlon,Shelp,Sdefault) = @_; 
local (Shtml, Syeschecked, Snochecked) = ("••;"',""); 

if ( Sdefault eq "yes" ) { Syeschecked = "SELECTED"; } 
if ( Sdefault eq "no" ) { Snochecked = "SELECTED"; } 

Shtml = "\ 

<TD ALIGN=\"CENTER\">\ 
<SELECT NAME=\"$name\">\ 

<OPTION Syeschecked VALUE=\"yesV'>Yes\ 

<OPTION VALUE=\"sometimesV'>Sometimes\ 

<OPTION VALUE=\"maybe\">Maybe\ 

<OPTION VALUE=\"unknown\">DonVt remember\ 

<OPTION Snochecked VALUE=\"no\">No\ 
</SELECT></TD>\ 

<TD>$questlon<a href=VYigotpain/Scgi_name/$help.html\" TARGET=\"reference\">(help)</a></TD>\ 
\n"; 

return($html); 
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} 

sub addbody { 
push(@bodyJines, @_); 

} 

sub printtitle { 
local ($title) = @_; 

print "<TITLE>$title</TITLE>"; 

} 

sub prlntbody { 
print "<BODY>"; 
if ($debug) {print "<pre>";} 
print @body_lines; 
if ($debug) {print "</PRE>";} 
print "</BODY>"; 

} 

sub printhtml { 
print "<HTML>\n"; 
&printtitle("$html_title"); 
&printbody; 
print "</HTML>\n"; 

} 

sub printheader { 
local ($cookie,$qlevel) = @_; 

print "Content-type: text/html\n"; 
print "Set-Cool<ie: $answercool^ienanne=$cookie\n" 
print "Set-Cookie: $levelcookiename=$qlevel\n"; 
print "\n"; 

} 



